2020 Continuous Monitoring Data
All 2020 continuous monitoring data were pulled from the Aquarius server via the Aquarius web service API using custom R functions.
The below charts are interactive. Click on a line or select a site name to add color to the corresponding monitoring station across the plots.
Click the box below “Color Brush” to choose a color. Multiple lines can be colored at any given time.
---
title: "2020 WQ Data"
output:
flexdashboard::flex_dashboard:
theme: lumen
source_code: embed
resource_files:
-Daphnia.jpg
---
```{r setup, include=FALSE}
options(scipen = 999)
knitr::opts_chunk$set(echo = FALSE)
library(knitr)
library(tidyverse)
library(plotly)
library(crosstalk)
library(mmsd.wq)
library(flexdashboard)
library(leaflet)
library(sf)
library(htmltools)
library(lubridate)
library(wesanderson)
#set working directory
#read in R data objects
wq20 <- readRDS("data/wq_data20.rds")
aq_data_mean <- readRDS("data/aq_data_crosstalk.rds")
wind_data <- readRDS("data/met_data_crosstalk.rds")
wq20_wtrBody <- readRDS("data/wq20_wtrBody.rds")
wq20_srvType <- readRDS("data/wq20_srvType.rds")
flow_data <- readRDS("data/flow_data.rds")
#shared data objects
wq_full <- SharedData$new(wq20)
wq_full2 <- SharedData$new(wq20)
wq_wtrBody <- SharedData$new(wq20_wtrBody,~parameter, group = "timeseries")
wq_srvType <- SharedData$new(wq20_srvType, ~parameter, group = "timeseries")
flow_data <- SharedData$new(flow_data, ~station_nm,group = "flow_data")
wind_data <- SharedData$new(wind_data, ~date)
```
```{js}
function filter_default() {
document.getElementById("parameter").getElementsByClassName("selectized")[0].selectize.setValue("1%_Depth", false);
document.getElementById("wq_full_parameter").getElementsByClassName("selectized")[0].selectize.setValue("SpCond",false);
document.getElementById("wq_full_collection_date").getElementsByClassName("selectized")[0].selectize.setValue("2020-01-14 - RI 1011",false);
document.getElementById("wq_full_depth").getElementsByClassName("selectized")[0].selectize.setValue("S",false)
document.getElementById("flow_data_site").getElementsByClassName("selectized")[0].selectize.setValue("MILWAUKEE RIVER AT MILWAUKEE, WI",false)
document.getElementById("survey_group").getElementsByClassName("selectized")[0].selectize.setValue("river",false)
}
window.onload = filter_default;
```
Grab Samples
===
Column {.sidebar}
-----------------------------------------------------------------------
Use the inputs to select parameters and sites to view.
```{r}
filter_select("parameter",
"Parameter:",
sharedData = wq_wtrBody,
multiple = FALSE,
~parameter)
```
---
**Data Source:**
Data were pulled from LIMS using the "fFreshwaterMonitoringDetailOpSID" SQL
function. Blanks and sequential field replicates were not included in the data pull. Non-detects were converted to half of their MDL.
**Plot Description:**
Data were grouped by waterbody,parameter, and date. The means and standard deviations were calculated across these groupings. A similar procedure was completed grouping
by survey type rather than waterbody.
Column {.tabset}
--------------------------------------------------------------------------------
### By WaterBody
```{r,fig.width = 12}
g <- ggplot(data = wq_wtrBody,
aes(x = lubridate::ymd(COLLECTION_DATE),
y = round(mean_wq,digits = 2),
group = parameter,
color = Depth)) +
geom_point()+
geom_line()+
geom_errorbar(aes(ymin=mean_wq-sd_wq, ymax=mean_wq+sd_wq), width=.2,
position=position_dodge(0.05))+
facet_wrap(~groupVar,scales = "free_y")+
ylab("Result")+
theme(axis.title.x=element_blank())
ggplotly(g,dynamicTicks = "y")
```
### By Survey Type
```{r,fig.width = 12}
g <- ggplot(data = wq_srvType,
aes(x = lubridate::ymd(COLLECTION_DATE),
y = mean_wq,
group = parameter,
color = Depth)) +
geom_point()+
geom_line()+
geom_errorbar(aes(ymin=mean_wq-sd_wq, ymax=mean_wq+sd_wq), width=.2,
position=position_dodge(0.05))+
facet_wrap(~groupVar,scales = "free_y")
ggplotly(g,dynamicTicks = "y")
```
### Site Map
```{r,fig.width = 12}
leaflet_site_map()
```
Continuous Monitoring
===
Column {.tabset}
--------------------------------------------------------------------------------
### Sonde Data
2020 Continuous Monitoring Data
All 2020 continuous monitoring data were pulled from the Aquarius server via the Aquarius web service API using custom R functions.
The below charts are interactive. Click on a line or select a site name to add color to the corresponding monitoring station across the plots.
Click the box below "Color Brush" to choose a color. Multiple lines can be colored at any given time.
---
```{r}
aq_highlight <- highlight_key(aq_data_mean,~LocationName)
g <- ggplot(aq_highlight,
aes(
x = day,
y = mean_value,
group = LocationName)) +
geom_line(color = "black")+
facet_wrap(~Parameter,scales = "free_y")+
xlim(ymd("2020-01-01","2020-12-31"))+
scale_x_date(date_labels = "%b")+
theme(panel.spacing.y = unit(1, "lines"),
panel.spacing.x = unit(0, "lines"),
axis.title.x=element_blank())
highlight(
ggplotly(g,height = 550),
selectize = TRUE,
persistent = TRUE,
dynamic = TRUE,
color = rainbow(n=7))
```
### Site Map
```{r}
sonde_sites <- con_mon_site_lookup %>%
filter(
LocationIdentifier %in% (
con_mon_param_lookup %>%
filter(lubridate::year(RawEndTime) == 2020) %>%
select(LocationIdentifier) %>%
distinct() %>%
pull()
) &
LocationType == "Water Quality Site"
) %>%
st_as_sf(coords = c("Longitude", "Latitude"), crs = 4326) %>%
st_transform(crs = 3071) %>%
st_buffer(dist = 200) %>%
st_transform(crs = 4326) %>%
mutate(image_path = map_chr(.x = list.files("images"),
~ renderTags(
htmltools::img(
src = image_uri(paste("images/",.x,sep="")),
width = '200',
height = '200')
)$html
)
)
leaflet()%>%
leaflet::addPolylines(
data = mke_rivers,
color = "blue",
popup = ~ paste(" River: ", ROW_NAME)) %>%
leaflet::addPolygons(data = sonde_sites,
color = "red",
popup = ~paste("test
",image_path)) %>%
leaflet::addProviderTiles(leaflet::providers$Esri.WorldImagery)
```
Survey Summary {data-orientation=columns}
===
Column {.sidebar}
-----------------------------------------------------------------------
**Map Description**
2020 WQ data were grouped by parameter and depth. The percent rank was calculated
for each record by these groupings. Percent rank can be between 0-100%. A percent
rank of 100% means that its value is greater than all of the data within its
grouping.
```{r}
filter_select("wq_full_parameter",
"Parameter:",
sharedData = wq_full,
multiple = FALSE,
~parameter)
filter_select("wq_full_collection_date",
"Collection Date:",
sharedData = wq_full,
multiple = FALSE,
~date_survey)
filter_select("wq_full_depth",
"Survey Num:",
multiple = FALSE,
sharedData = wq_full,
~Depth)
```
---
**Hydrology Data**
USGS Flow data were directly read into R via a REST API.
Wind data were pulled from the Aquarius server. Click and drag on a plot or use the range sliders to filter the view.
```{r}
filter_select("flow_data_site",
"Select USGS Gauge Site:",
sharedData = flow_data,
multiple = TRUE,
~station_nm)
```
Row {data-height = 500}
--------------------------------------------------------------------------------
###
```{r}
pal <- colorNumeric(
palette = colorRampPalette(c('green','yellow', 'red'))(100),
domain = wq_full$perc_rank)
leaflet()%>%
leaflet::addPolylines(
data = mke_rivers,
color = "blue",
popup = ~ paste(" River: ", ROW_NAME)) %>%
addCircles(data = wq_full,
color = ~pal(perc_rank),
fillColor = ~pal(perc_rank),
fillOpacity = 0.85,
radius = 200,
popup = ~ paste(" Site: ",SITE_CODE,"
",
" Survey: ",SURVEY_NUM,"
",
" Date: ",COLLECTION_DATE,"
",
" Parameter: ",parameter,"
",
" Percent Rank: ", perc_rank,"
",
" Result: :",ReadingNum,
sep =""))%>%
addProviderTiles(providers$Esri.WorldImagery)%>%
addLegend("bottomright", pal = pal, values = wq20$perc_rank,
title = "Percent Rank",
labFormat = labelFormat(suffix = "%"),
opacity = 1
)
```
Column {.tabset}
--------------------------------------------------------------------------------
### Hydro Data
#### USGS Flow Data
```{r}
plot_ly(
flow_data,
x = ~ date,
y = ~ mean_flow,
color = ~ station_nm,
mode = "lines",height = 300) %>%
layout(legend = list(orientation = 'h'))%>%
rangeslider()
```
#### Jones Island Wind Data
```{r}
plot_ly(wind_data,
x = ~date,
y = ~wind_vel,
height = 350)%>%
add_annotations(text = knitr::asis_output("\U2B9D"),
yshift = -1,
showarrow = FALSE,
textangle = ~wind_dir)%>%
add_markers(opacity = 0,
name = paste("Wind Direction(",
knitr::asis_output("\U2B9D"),
"N)",
sep = ""))%>%
add_lines(name = 'Wind Velocity',
line = list(color = 'rgb(201, 194, 193)',
width = 2))%>%
layout(legend = list(orientation = 'h'),
xaxis = list(title = ""),yaxis = list(title = "Wind Velocity (mph)"))%>%
rangeslider()
```
### Two